{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit MediaRepository;

interface

uses Classes, MediaSchema, MediaFolders, TagParser, NameValues;

const
  VARIOUS_ARTIST = 'Various';
  VARIOUS_ID = 1;

type
  // Lightweight cache for genre details
  TGenreRecord = record
    Id: Integer;
    Name: String;
    Duration: Word;
    Tracks: Word;
  end;

  // Lightweight cache for artist details
  TArtistRecord = record
    Id: Integer;
    Name: String;
    Duration: Word;
    Tracks: Word;
    ImageURL: WideString;
  end;

  // Lightweight cache for album details
  TAlbumRecord = record
    Id: Integer;
    Name: String;
    ArtistId: Integer;
    GenreId: Integer;
    Duration: Word;
    Tracks: Word;
    Year: Integer;
    ImageURL: WideString;
  end;

  PGenreRecord = ^TGenreRecord;
  PArtistRecord = ^TArtistRecord;
  PAlbumRecord = ^TAlbumRecord;

  TAHMScannerCallback = procedure(Files, Folders, Failed: Integer; Complete: Boolean) of object;

  TAHMImportThread = class(TThread)
  private
    FCallback: TAHMScannerCallback;
    FFolderList: TAHMMediaFolderList;
    FImages: TAHMNameValueList;
    FSchema: TAHMMediaSchema;
    FThumbPath: WideString;
    FFiles: Integer;
    FFolders: Integer;
    FFailed: Integer;
  protected
    procedure DoBusyCallback;
    procedure DoFinalCallback;
    procedure Initialise; virtual;
    procedure Finalise; virtual;
    procedure ScanMedia; virtual;
  public
    constructor Create(CreateSuspended: Boolean);
    property FolderList: TAHMMediaFolderList read FFolderList write FFolderList;
    property FolderImages: TAHMNameValueList read FImages write FImages;
    property ThumbnailPath: WideString read FThumbPath write FThumbPath;
    property Schema: TAHMMediaSchema read FSchema write FSchema;
    property Callback: TAHMScannerCallback read FCallback write FCallback;
    procedure Execute; override;
  end;

  TAHMScannerThread = class(TAHMImportThread)
  protected
    procedure ScanMedia; override;
    procedure ScanFolder(FolderName: WideString);
    procedure ScanFile(TagType: TAHMTagType; const Folder, FileName: WideString); virtual;
  end;

  TAHMTagReaderThread = class(TAHMScannerThread)
  private
    FParser: TAHMMediaTagParser;
    FGenre: String;
    FArtist: String;
    FAlbum: String;
    FGenreId: Integer;
    FGenreRec: PGenreRecord;
    FArtistId: Integer;
    FArtistRec: PArtistRecord;
    FAlbumId: Integer;
    FAlbumRec: PAlbumRecord;
    FGenres: TStringList;
    FArtists: TStringList;
    FAlbums: TStringList;
  protected
    procedure Initialise; override;
    procedure Finalise; override;
    procedure ScanFile(TagType: TAHMTagType; const Folder, FileName: WideString); override;
  public
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
  end;

  TAHMIndexThread = class(TAHMImportThread)
  protected
    procedure Initialise; override;
    procedure ScanMedia; override;
  end;

  TAHMMediaRepository = class
  private
    FThread: TAHMImportThread;
    FSchema: TAHMMediaSchema;
    FCallback: TAHMScannerCallback;
    FFolderList: TAHMMediaFolderList;
    FImages: TAHMNameValueList;
    FThumbPath: WideString;
  protected
    function GetCompleted: Boolean;
    procedure ThreadProgress(Files, Folders, Failed: Integer; Complete: Boolean);
  public
    constructor Create;
    destructor Destroy; override;
    property Completed: Boolean read GetCompleted;
    property Callback: TAHMScannerCallback read FCallback write FCallback;
    property FolderList: TAHMMediaFolderList read FFolderList write FFolderList;
    property ThumbnailPath: WideString read FThumbPath write FThumbPath;
    property Schema: TAHMMediaSchema read FSchema;
    procedure CountMedia;
    procedure ScanMedia;
    procedure IndexMedia;
    procedure WaitForCompletion;
    procedure Abort;
    procedure CreateTemporaryFile(Path: WideString);
    function OpenExistingFile(Path: WideString): Boolean;
    function PromoteTemporaryFile(Path: WideString): Boolean;
    class function DatabaseExists(Path: WideString): Boolean;
  end;

implementation

uses SysUtils, StrUtils, TagUtils, Unicode;

const
  RETURN_COMPLETE = 1;
  TEMP_PREFIX = '_';

// TAHMImportThread

constructor TAHMImportThread.Create(CreateSuspended: Boolean);
begin
  inherited;

  // Initialise thread properties
  FreeOnTerminate := False;
end;

procedure TAHMImportThread.DoBusyCallback;
begin
  FCallback(FFiles, FFolders, FFailed, False);
end;

procedure TAHMImportThread.DoFinalCallback;
begin
  FCallback(FFiles, FFolders, FFailed, True);
end;

procedure TAHMImportThread.Execute;
begin
  Initialise;
  ScanMedia;

  // Final callback to signal completion
  Synchronize(DoFinalCallback);

  Finalise;
  ReturnValue := RETURN_COMPLETE;
end;

procedure TAHMImportThread.Initialise;
begin
  // Reset scanning stats
  FFiles := 0;
  FFolders := 0;
  FFailed := 0;
end;

procedure TAHMImportThread.ScanMedia;
begin
  // Descendants may implement this if required
end;

procedure TAHMImportThread.Finalise;
begin
  // Descendants may implement this if required
end;

// TAHMScannerThread

procedure TAHMScannerThread.ScanMedia;
var
  i: Integer;
begin
  for i := 0 to Pred(FFolderList.Count) do
    ScanFolder(FFolderList[i].FolderPath);
end;

procedure TAHMScannerThread.ScanFolder(FolderName: WideString);
var
  SR: TSearchRecW;
  DirList: array of WideString;
  DirCount, DirCapacity: Integer;
  Found, i: Integer;
  TagType: TAHMTagType;
begin
  // Ensure directory has a trailing slash
  if (FolderName <> '') and (FolderName[Length(FolderName)] <> '\') then
    FolderName := FolderName + '\';

  // Defer allocating directory list until required
  DirCount := 0;
  DirCapacity := 0;

  // Scan all files in this directory
  Found := FindFirstW(FolderName + '*.*', faAnyFile, SR);
  while (Found = 0) and not Terminated do
  begin
    try
      if (SR.Attr and faDirectory) <> 0 then
      begin
        if LeftStr(SR.Name, 1) <> '.' then
        begin
          // Make a note of this folder for checking later
          if DirCapacity = DirCount then
          begin
            Inc(DirCapacity, DirCapacity * 2 + 4);
            SetLength(DirList, DirCapacity);
          end;
          DirList[DirCount] := FolderName + SR.Name;
          Inc(DirCount);
        end
      end
      else
      begin
        // Check for a supported tag type
        TagType := GetTagType(SR.Name);
        if TagType <> ttUnknown then
        begin
          // Process this file
          ScanFile(TagType, FolderName, SR.Name);

          if TagType <> ttImage then
          begin
            // Increment stats and report progress to callback
            Inc(FFiles);
            if (FFiles mod 10) = 0 then Synchronize(DoBusyCallback);
          end;
        end;
      end;
    except
      Inc(FFailed);
    end;

    // Keep looking
    Found := FindNextW(SR);
  end;
  FindCloseW(SR);

  // Scan the list of subdirectories recursively
  if (DirCount > 0) and not Terminated then
    for i := 0 to Pred(DirCount) do
      ScanFolder(DirList[i]);
end;

procedure TAHMScannerThread.ScanFile(TagType: TAHMTagType; const Folder, FileName: WideString);
var
  Index: Integer;
begin
  // Just need to look for image files whilst counting
  if TagType = ttImage then
  begin
    Index := FImages.IndexOf(Folder);

    // Look for best match for album art by comparing filenames
    if Index < 0 then
      FImages.AddValue(Folder, FileName)
    else if GetAlbumArtMatch(FileName) > GetAlbumArtMatch(FImages.Values[Index]) then
      FImages.Values[Index] := FileName;
  end;
end;

// TAHMTagReaderThread

constructor TAHMTagReaderThread.Create(CreateSuspended: Boolean);
begin
  inherited;

  FParser := TAHMMediaTagParser.Create;

  // Build stringlists for cacheing
  FGenres := TStringList.Create;
  FArtists := TStringList.Create;
  FAlbums := TStringList.Create;
  FGenres.Sorted := True;
  FArtists.Sorted := True;
  FAlbums.Sorted := True;
  FGenres.Duplicates := dupIgnore;
  FArtists.Duplicates := dupIgnore;
  FAlbums.Duplicates := dupIgnore;
end;

destructor TAHMTagReaderThread.Destroy;
begin
  FParser.Free;
  FArtists.Free;
  FGenres.Free;
  FAlbums.Free;

  inherited;
end;

procedure TAHMTagReaderThread.Initialise;
var
  Genre: PGenreRecord;
  Artist: PArtistRecord;
  Album: PAlbumRecord;
begin
  inherited;

  // Set properties for tag parser
  FParser.ThumbnailPath := FThumbPath;
  FParser.CreateThumbnails := True;

  // Add dummy item for empty genre
  New(Genre);
  FillChar(Genre^, SizeOf(TGenreRecord), 0);
  FGenres.AddObject('', TObject(Genre));

  // Add dummy item for empty artist
  New(Artist);
  FillChar(Artist^, SizeOf(TArtistRecord), 0);
  FArtists.AddObject('', TObject(Artist));

  // Add dummy item for "Various" artist
  New(Artist);
  FillChar(Artist^, SizeOf(TArtistRecord), 0);
  Artist.Id := VARIOUS_ID;
  Artist.Name := VARIOUS_ARTIST;
  FArtists.AddObject(Uppercase(VARIOUS_ARTIST), TObject(Artist));

  // Add dummy item for empty album
  New(Album);
  FillChar(Album^, SizeOf(TAlbumRecord), 0);
  FAlbums.AddObject('', TObject(Album));

  // Prepare database for inserts
  FSchema.PrepareInsertQueries;
  FSchema.DB.Synchronised := False;
  FSchema.DB.BeginTransaction;
end;

procedure TAHMTagReaderThread.Finalise;
var
  i: Integer;
  Genre: PGenreRecord;
  Artist: PArtistRecord;
  Album: PAlbumRecord;
begin
  inherited;

  // Write cached genres, artists & albums
  for i := 0 to Pred(FGenres.Count) do
  begin
    Genre := PGenreRecord(FGenres.Objects[i]);
    with Genre^ do
      FSchema.InsertGenre(Id, Name, Duration, Tracks);
    Dispose(Genre);
  end;
  for i := 0 to Pred(FArtists.Count) do
  begin
    Artist := PArtistRecord(FArtists.Objects[i]);
    with Artist^ do
      FSchema.InsertArtist(Id, Name, EncodeWideString(ImageURL), Duration, Tracks);
    Dispose(Artist);
  end;
  for i := 0 to Pred(FAlbums.Count) do
  begin
    Album := PAlbumRecord(FAlbums.Objects[i]);
    with Album^ do
      FSchema.InsertAlbum(Id, Name, EncodeWideString(ImageURL), ArtistId,
                          GenreId, Year, Duration, Tracks);
    Dispose(Album);
  end;

  FSchema.BuildIndexes;
  FSchema.DB.Commit;
  FSchema.ReleaseInsertQueries;
end;

procedure TAHMTagReaderThread.ScanFile(TagType: TAHMTagType; const Folder, FileName: WideString);
var
  Tags: TAHMMediaTags;
  ImageURL: WideString;
begin
  // Ignore album art on second pass
  if TagType = ttImage then Exit;

  Tags := FParser.Parse(Folder, FileName);
  if Tags <> nil then
  begin
    // Get unique Id for genre
    if FGenre <> Tags.MatchGenre then
    begin
      FGenre := Tags.MatchGenre;
      FGenreId := FGenres.AddObject(FGenre, nil);
      FGenreRec := PGenreRecord(FGenres.Objects[FGenreId]);
    end;

    // If this is a new genre then cache its details
    if FGenreRec = nil then
    begin
      New(FGenreRec);
      FGenres.Objects[FGenreId] := TObject(FGenreRec);
      FGenreId := FGenres.Count - 1;
      FGenreRec.Id := FGenreId;
      FGenreRec.Name := Tags.Genre;
      FGenreRec.Duration := Tags.Duration;
      FGenreRec.Tracks := 1;
    end
    else
    begin
      // Lookup correct genre id
      FGenreId := FGenreRec.Id;

      // Correct a few genre tags as we find additional tracks
      if FGenreId <> 0 then
      begin
        // Update total duration and track count
        FGenreRec.Duration := FGenreRec.Duration + Tags.Duration;
        FGenreRec.Tracks := FGenreRec.Tracks + 1;
      end;
    end;

    // Get unique Id for artist
    if FArtist <> Tags.MatchArtist then
    begin
      FArtist := Tags.MatchArtist;
      FArtistId := FArtists.AddObject(FArtist, nil);
      FArtistRec := PArtistRecord(FArtists.Objects[FArtistId]);
    end;

    // If this is a new artist then cache its details
    if FArtistRec = nil then
    begin
      New(FArtistRec);
      FArtists.Objects[FArtistId] := TObject(FArtistRec);
      FArtistId := FArtists.Count - 1;
      FArtistRec.Id := FArtistId;
      FArtistRec.Name := Tags.TitleArtist;
      FArtistRec.Duration := Tags.Duration;
      FArtistRec.Tracks := 1;
      FArtistRec.ImageURL := '';
    end
    else
    begin
      // Lookup correct artist id
      FArtistId := FArtistRec.Id;

      // Correct a few artist tags as we find additional tracks
      if FArtistId <> 0 then
      begin
        // Look for a better artist name, i.e. one with "The"
        if Pos('THE', UpperCase(Tags.TitleArtist)) > 0 then
          FArtistRec.Name := Tags.TitleArtist;

        // Update total duration and track count
        FArtistRec.Duration := FArtistRec.Duration + Tags.Duration;
        FArtistRec.Tracks := FArtistRec.Tracks + 1;
      end;
    end;

    // Get unique Id for album
    if FAlbum <> Tags.MatchCompilation then
    begin
      FAlbum := Tags.MatchCompilation;
      FAlbumId := FAlbums.AddObject(FAlbum, nil);
      FAlbumRec := PAlbumRecord(FAlbums.Objects[FAlbumId]);
    end;

    // If this is a new album then cache its details
    if FAlbumRec = nil then
    begin
      New(FAlbumRec);
      FAlbums.Objects[FAlbumId] := TObject(FAlbumRec);
      FAlbumId := FAlbums.Count - 1;
      FAlbumRec.Id := FAlbumId;
      FAlbumRec.Name := Tags.CompilationTitle;
      FAlbumRec.Duration := Tags.Duration;
      FAlbumRec.Tracks := 1;
      FAlbumRec.ArtistId := FArtistId;
      FAlbumRec.GenreId := FGenreId;
      FAlbumRec.Year := Tags.Year;
      ImageURL := FImages.GetValue(Folder);
      if ImageURL <> '' then FAlbumRec.ImageURL := Folder + ImageURL
                        else FAlbumRec.ImageURL := '';

      // Increment album stats
      Inc(FFolders);
    end
    else
    begin
      // Lookup correct album id
      FAlbumId := FAlbumRec.Id;

      // Correct a few album tags as we find additional tracks
      if FAlbumId <> 0 then
      begin
        if Tags.Year > FAlbumRec.Year then FAlbumRec.Year := Tags.Year; // Highest year
        if FAlbumRec.GenreId = 0 then FAlbumRec.GenreId := FGenreId; // Missing genre
        if FAlbumRec.ArtistId = 0 then FAlbumRec.ArtistId := FArtistId; // Missing artist then
        if (FAlbumRec.ArtistId <> FArtistId) and (FArtistId <> 0) then
          FAlbumRec.ArtistId := 1; // Various artists

        // Update total duration and track count
        FAlbumRec.Duration := FAlbumRec.Duration + Tags.Duration;
        FAlbumRec.Tracks := FAlbumRec.Tracks + 1;

        // Update missing album art for album
        if FAlbumRec.ImageURL = '' then
        begin
          ImageURL := FImages.GetValue(Folder);
          if ImageURL <> '' then FAlbumRec.ImageURL := Folder + ImageURL;
        end;
      end;
    end;

    // Update missing album art for artist
    if (FArtistRec.ImageURL = '') and (FAlbumRec.ArtistId = FArtistId) then
      FArtistRec.ImageURL := FAlbumRec.ImageURL;

    // Write the media item record with UTF8 encoding of URL
    FSchema.InsertMediaItem(FFiles + 1, Tags.Title, FAlbumId, FArtistId, FGenreId,
                            EncodeWideString(Folder + FileName), Tags.Year,
                            Tags.Duration, Tags.TrackNumber, Tags.Bitrate,
                            (Tags.ImageURL <> ''));
  end;
end;

// TAHMIndexThread

procedure TAHMIndexThread.Initialise;
begin
  inherited;

  FSchema.BuildCaches;
end;

procedure TAHMIndexThread.ScanMedia;
var
  i: Integer;
  Hash: String;
  ThumbURL: WideString;
begin
  // Look for previously stored custom artwork for all albums
  for i := 1 to Pred(FSchema.AlbumCount) do
  begin
    Hash := FSchema.GetAlbumHash(i);
    ThumbURL := FThumbPath + GetThumbnailName(Hash);

    // If image found, then update schema to reference it
    if FileExistsW(ThumbURL) then
      FSchema.UpdateAlbumArt(i, EncodeWideString(ThumbURL));

    // Increment stats and report progress to callback
    Inc(FFolders);
    if (FFolders mod 20) = 0 then Synchronize(DoBusyCallback);
  end;
end;

// TAHMMediaRepository

constructor TAHMMediaRepository.Create;
begin
  inherited;

  FSchema := TAHMMediaSchema.Create;
  FImages := TAHMNameValueList.Create;
end;

destructor TAHMMediaRepository.Destroy;
begin
  FSchema.Free;
  FImages.Free;

  inherited;
end;

function TAHMMediaRepository.GetCompleted: Boolean;
begin
  Result := False;

  if FThread = nil then
    Result := True
  else if FThread.ReturnValue = RETURN_COMPLETE then
  begin
    Result := True;
    FreeAndNil(FThread);
  end;
end;

procedure TAHMMediaRepository.CountMedia;
begin
  FImages.Clear;
  FThread := TAHMScannerThread.Create(True);
  FThread.FolderList := FFolderList;
  FThread.FolderImages := FImages;
  FThread.Callback := ThreadProgress;
  FThread.Resume;
end;

procedure TAHMMediaRepository.ScanMedia;
begin
  FThread := TAHMTagReaderThread.Create(True);
  FThread.Schema := FSchema;
  FThread.FolderList := FFolderList;
  FThread.FolderImages := FImages;
  FThread.ThumbnailPath := FThumbPath;
  FThread.Callback := ThreadProgress;
  FThread.Resume;
end;

procedure TAHMMediaRepository.IndexMedia;
begin
  FThread := TAHMIndexThread.Create(True);
  FThread.Schema := FSchema;
  FThread.ThumbnailPath := FThumbPath;
  FThread.Callback := ThreadProgress;
  FThread.Resume;
end;

procedure TAHMMediaRepository.WaitForCompletion;
begin
  if FThread <> nil then FThread.WaitFor;
  FreeAndNil(FThread);
end;

procedure TAHMMediaRepository.Abort;
begin
  if FThread <> nil then
    FThread.Terminate;
end;

procedure TAHMMediaRepository.ThreadProgress(Files, Folders, Failed: Integer; Complete: Boolean);
begin
  if Assigned(FCallback) then FCallback(Files, Folders, Failed, Complete);
end;

procedure TAHMMediaRepository.CreateTemporaryFile(Path: WideString);
var
  TempFile: WideString;
begin
  // Delete any old temporary database file
  TempFile := Path + TEMP_PREFIX + MEDIA_DB_FILENAME;
  if FileExistsW(TempFile) then DeleteFileW(TempFile);

  // Point schema to this temporary file & populate structure
  FSchema.FileName := TempFile;
  FSchema.CheckSchema;
end;

function TAHMMediaRepository.OpenExistingFile(Path: WideString): Boolean;
begin
  // Point schema to database file & validate structure
  FSchema.FileName := Path + MEDIA_DB_FILENAME;
  Result := FSchema.CheckSchema;

  // Populate caches if db opened correctly
  if Result then FSchema.BuildCaches;
end;

function TAHMMediaRepository.PromoteTemporaryFile(Path: WideString): Boolean;
var
  TempFile: WideString;
begin
  // Flush any outstanding writes
  FSchema.Close;

  // Overwrite live file with our temporary one
  TempFile := Path + TEMP_PREFIX + MEDIA_DB_FILENAME;
  Result := CopyFileW(TempFile, Path + MEDIA_DB_FILENAME, True);
end;

class function TAHMMediaRepository.DatabaseExists(Path: WideString): Boolean;
begin
  // Check for a live media database file
  Result := FileExists(Path + MEDIA_DB_FILENAME);
end;


end.
